home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / SORT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  4KB  |  116 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 492 of 527
  3. From : Alexander Christov                  2:341/34.0           14 May 93  12:42
  4. To   : All
  5. Subj : Sorting routines (1/3)
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hi All!
  8.  
  9.  I don't know if code like this has been posted on this echo, but anyway here it
  10. goes. It implements three different versions of Qsort which so far if the
  11. fastest sorting algorithm known. However, it is not adequate for sorting file
  12. records. I've tested the routines and have worked with them for quite a while,
  13. but don't trust me 8-) Murphy never sleeps 8-)}
  14.  
  15. UNIT SORT;
  16. {─────────────────────────────────────────────────────────────────────────}
  17. { Purpose  : Unit that implements a generic QSort(), similar to           }
  18. {            the one in the standard C library.                           }
  19. { Author   : Alexander Christov                                           }
  20. { Notes    : Very instructive on the use of pointers in TP.               }
  21. {                                                                         }
  22. {  Use freely.                                                            }
  23. {                                                                         }
  24. {─────────────────────────────────────────────────────────────────────────}
  25. INTERFACE
  26.  
  27. TYPE CmpFunc=Function(El1,El2:Pointer):Boolean;
  28.  
  29. Procedure QSort(Base:Pointer;Elements,Size:WORD;GT:CmpFunc);
  30.  
  31. { Base      - Pointer to the first element
  32.   Elements  - Number of elements
  33.   Size      - Size of an element in bytes. Use SizeOf() if in doubt
  34.   GT        - A function of type CmpFunc that compares the elements pointed
  35.               to by the first and the second arguments and returns TRUE
  36.               if the first is greater than the second. GT = Greater Than
  37.               8-)
  38. }
  39.  
  40. { Some commonly used CmpFunc }
  41.  
  42. Function bGT(El1,El2:Pointer):Boolean;      { Compares ^BYTE }
  43. Function wGT(El1,El2:Pointer):Boolean;      { Compares ^WORD }
  44. Function lGT(El1,El2:Pointer):Boolean;      { Compares ^LONGINT }
  45. Function rGT(El1,El2:Pointer):Boolean;      { Compares ^REAL }
  46.  
  47. IMPLEMENTATION
  48. {$F+}
  49.  
  50. TYPE Dummy=ARRAY[0..0] OF BYTE;
  51.      pDummy=^Dummy;
  52.  
  53.  
  54. { Recursive implementation }
  55.  
  56. Procedure _Sort(Base:Pointer;L,R,Size:WORD;GT:CmpFunc);
  57. VAR I,J:Integer;
  58. VAR X:Pointer;
  59.  Procedure SwapElements(El1,El2:Word);
  60.  VAR Tmp:Pointer;
  61.  BEGIN
  62.   GetMem(Tmp,Size);
  63.   Move(pDummy(Base)^[El1*Size],Tmp^,Size);
  64.   Move(pDummy(Base)^[El2*Size],pDummy(Base)^[El1*Size],Size);
  65.   Move(Tmp^,pDummy(Base)^[El2*Size],Size);
  66.   FreeMem(Tmp,Size);
  67.  END;
  68. BEGIN
  69.  I:=L;
  70.  J:=R;
  71.  GetMem(X,Size);
  72.  Move(pDummy(Base)^[((L+R) div 2)*Size],X^,Size);
  73.  REPEAT
  74.   While GT(X,@pDummy(Base)^[I*Size]) DO INC(I);
  75.   While GT(@pDummy(Base)^[J*Size],X) DO DEC(J);
  76.   IF I<=J THEN BEGIN
  77.    IF I<>J THEN SwapElements(I,J);
  78.    INC(I);
  79.    DEC(J);
  80.   END;
  81.  UNTIL I>J;
  82.  FreeMem(X,Size);
  83.  IF L<J THEN _Sort(Base,L,J,Size,GT);
  84.  IF I<R THEN _Sort(Base,I,R,Size,GT);
  85. END;
  86.  
  87. Procedure QSort(Base:Pointer;Elements,Size:WORD;GT:CmpFunc);
  88. BEGIN
  89.  _Sort(Base,0,Elements-1,Size,GT);
  90. END;
  91.  
  92. Function bGT(El1,El2:Pointer):Boolean;
  93. TYPE pByte=^Byte;
  94. BEGIN
  95.  bGt:=(pByte(El1)^>pByte(El2)^);
  96. END;
  97.  
  98. Function wGT(El1,El2:Pointer):Boolean;
  99. TYPE pWord=^Word;
  100. BEGIN
  101.  wGt:=(pWord(El1)^>pWord(El2)^);
  102. END;
  103.  
  104. Function lGT(El1,El2:Pointer):Boolean;
  105. TYPE pLongint=^Longint;
  106. BEGIN
  107.  lGt:=(pLongInt(El1)^>pLongInt(El2)^);
  108. END;
  109.  
  110. Function rGT(El1,El2:Pointer):Boolean;
  111. TYPE pReal=^Real;
  112. BEGIN
  113.  rGt:=(pReal(El1)^>pReal(El2)^);
  114. END;
  115.  
  116. END.